An Analysis of TF2 Server Game Info
library(ggplot2)
theme_set(theme_minimal()) # ggplot2 theme
library(plotly)
library(knitr)
library(jsonlite)
library(dotenv)
library(mongolite)
load_dot_env(file = ".env")
con <- mongo(
db = "tf2",
collection = "snapshots",
url = Sys.getenv("MONGODB_CONN_STRING")
)
start.time <- Sys.time()
# get data from mongodb
# sg
data <- con$find(
'{ "info.server_name": {"$regex": "Singapore", "$options": "i"} }',
'{ "playerCount": { "$size": "$players" }, "timestamp": 1, "_id": 0 }'
)
# # sg and hk
# data_all <- con$find(
# fields = '{ "playerCount": { "$size": "$players" }, "timestamp": 1, "_id": 0 }'
# )
# finish timing
end.time <- Sys.time()
time.taken <- end.time - start.time
time.taken
## Time difference of 2.896264 secs
start.time <- Sys.time()
# group by timestamp
df <- aggregate(
data$playerCount,
by = list(Category = data$timestamp),
FUN = sum
)
names(df)[names(df) == 'x'] <- 'count'
names(df)[names(df) == 'Category'] <- 'unixTS'
# convert timestamp to date type
convertTimestamp <- function(ts){
date <- as.POSIXct(ts, origin = "1970-01-01")
return(date)
}
df$timestamp <- convertTimestamp(df$unixTS)
# setting up for ggplot rectangles
v <- df$timestamp %>%
weekdays()
isWeekend <- function(weekdayStr) {
if (weekdayStr %in% c("Saturday", "Sunday")) {
return(1)
}
else {
return(0)
}
}
# https://stackoverflow.com/questions/32543176/highlight-areas-within-certain-x-range-in-ggplot2
# create rectangles to highlight in ggplot
v <- sapply(v, isWeekend)
## Get the start and end points for highlighted regions
inds <- diff(c(0, v))
start <- df$timestamp[inds == 1]
end <- df$timestamp[inds == -1]
if (length(start) > length(end)) end <- c(end, tail(df$timestamp, 1))
## highlight region data
rects <- data.frame(start=start, end=end, group=seq_along(start))
# finally creating the plot
g <- ggplot(
df,
aes(
x = timestamp,
y = count
)
) +
scale_x_datetime(
breaks = "1 day",
date_labels = "%d %b",
) +
geom_rect(data = rects,
inherit.aes = FALSE,
aes(
xmin = start,
xmax = end,
ymin = min(df$count),
ymax = max(df$count),
group = group
),
color = "transparent",
fill = "orange", alpha = 0.2
) +
geom_line() +
labs(
title = "Concurrent Players in TF2 Casual Servers (Singapore)",
x = "Time (GMT +8)",
y = "Player Count",
)
# display plot and disable hover info for rects layer
ggplotly(g) %>%
style(hoverinfo = "none", traces = 1)
# finish timing
end.time <- Sys.time()
time.taken <- end.time - start.time
time.taken
## Time difference of 0.7760429 secs
# https://stats.stackexchange.com/questions/36309/how-do-i-find-peaks-in-a-dataset
# https://rpubs.com/mengxu/peak_detection
x <- df$unixTS[-(1:6000)]
y <- df$count[-(1:6000)]
argmax <- function(x, y, w=1, ...) {
require(zoo)
n <- length(y)
y.smooth <- loess(y ~ x, ...)$fitted
y.max <- rollapply(zoo(y.smooth), 2*w+1, max, align="center")
delta <- y.max - y.smooth[-c(1:w, n+1-1:w)]
i.max <- which(delta <= 0) + w
list(x=x[i.max], i=i.max, y.hat=y.smooth)
}
w <- 50 # range to find peaks
span <- 0.02 # smoothing factor
# test <- function(w, span) {
peaks <- argmax(x, y, w=w, span=span)
plot(x, y, cex=0.75, col="Gray", main=paste("w = ", w, ", span = ", span, sep=""))
lines(x, peaks$y.hat, lwd=2) #$
y.min <- min(y)
sapply(peaks$i, function(i) lines(c(x[i],x[i]), c(y.min, peaks$y.hat[i]), col="Red", lty=2))
## [[1]]
## NULL
##
## [[2]]
## NULL
##
## [[3]]
## NULL
##
## [[4]]
## NULL
##
## [[5]]
## NULL
##
## [[6]]
## NULL
##
## [[7]]
## NULL
##
## [[8]]
## NULL
##
## [[9]]
## NULL
##
## [[10]]
## NULL
##
## [[11]]
## NULL
##
## [[12]]
## NULL
##
## [[13]]
## NULL
##
## [[14]]
## NULL
points(x[peaks$i], peaks$y.hat[peaks$i], col="Red", pch=19, cex=1.25)

# }
x[peaks$i] %>%
convertTimestamp() %>%
format("%d %b, %I:%M:%S %p")
## [1] "26 Jun, 03:43:43 PM" "26 Jun, 10:13:43 PM" "27 Jun, 04:11:12 PM" "27 Jun, 10:25:00 PM" "28 Jun, 05:19:11 PM" "28 Jun, 09:06:59 PM" "29 Jun, 04:59:46 PM" "29 Jun, 09:46:16 PM"
## [9] "30 Jun, 05:34:14 PM" "30 Jun, 09:49:14 PM" "01 Jul, 05:04:58 PM" "01 Jul, 10:01:58 PM" "02 Jul, 05:15:34 PM" "02 Jul, 09:57:34 PM"
start.time <- Sys.time()
# timestamp of most recent set of server data in mongo
last_ts <- tail(df, n = 1)$unixTS
query_str <- paste('{ "timestamp":', last_ts, '}')
most_recent_scan <- con$find(query_str)
pretty_date <- convertTimestamp(last_ts) %>%
format("%d %b, %I:%M:%S %p")
paste("Servers with Players at", pretty_date, "<br>Next scan will happen 3 minutes from that time") %>%
cat()
replace_unicode_format <- function(unicode_str){
# actual str is <U+0223>
# take <U+0223>
# return ȣ
html_unicode <- paste("&#x", substr(unicode_str, 7, 10), ";", sep = "")
return(html_unicode)
}
fix_unicode <- function(html_string){
stringr::str_replace_all(
html_string,
"<U\\+([0-9A-F]{4,8})>",
replace_unicode_format
)
}
for (i in 1:nrow(most_recent_scan)){
server_data <- most_recent_scan[i,]
# server data, tranposed for key: val layout
kable(server_data[1:3] %>% t(), format = "html") %>%
print()
# player data
# sanitise player names
server_data$players[[1]]$name <- server_data$players[[1]]$name %>%
htmltools::htmlEscape() # %>%
# textutils::HTMLencode()
# debugging - REMOVE WHEN DONE TESTING
# format table and display
server_data$players[[1]] %>%
kable(format = "html") %>%
fix_unicode() %>%
print()
}
end.time <- Sys.time()
time.taken <- end.time - start.time
time.taken